home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / camlMode.tcl < prev    next >
Encoding:
Text File  |  1998-08-19  |  8.9 KB  |  231 lines  |  [TEXT/ALFA]
  1. # (install)
  2. ###############################################################################
  3. # camlMode.tcl  
  4. ##############################################################################
  5.  
  6. alpha::mode Caml 1.00 dummyCaml {*.ml *.mli} {
  7.     camlMenu electricReturn electricBraces electricTab
  8. } {
  9.     addMenu camlMenu "•321" Caml
  10.     set modeCreator(Caml) Caml
  11.     set unixMode(Caml) {Caml}
  12. } uninstall this-file maintainer {
  13.     "Patrick Cousot" <cousot@dmi.ens.fr> <http://www.dmi.ens.fr/~cousot/>
  14. } help {
  15.     This mode is for editing Caml Light code.  Caml Light is a small, portable 
  16.     implementation of the ML language that runs on most Unix machines, the 
  17.     Macintosh, the PC, and other microcomputers (freely distributed on 
  18.     ftp.inria.fr/lang/caml-light).
  19. }
  20.  
  21. namespace eval Caml {}
  22.  
  23. #=============================================================================
  24. # dummy proc to load the Caml mode.  
  25. #
  26. proc dummyCaml {} {}
  27.  
  28. #=============================================================================
  29. # dummy proc to load the code to make the camlMenu 
  30. #
  31. proc camlMenu {} {}
  32.  
  33. #=============================================================================
  34. #    Set up package-specific mode variables
  35. #
  36. newPref f wordWrap 0 Caml
  37. newPref f autoMark 1 Caml
  38. # Number of blanks left at beginning of lines by 'fill' routines.
  39. newPref v leftFillColumn {3} Caml
  40. # Set to the regular expression that ALPHA uses to find function 
  41. # declarations.
  42. newPref v funcExpr  {(let|type|and|value|exception)([\s\t\r\n]+rec)?[\s\t\r\n]+([a-zA-Z][a-zA-Z0-9_']*)} Caml
  43. newPref v parseExpr {(let|type|and|value|exception)([\s\t\r\n]+rec)?[\s\t\r\n]+([a-zA-Z][a-zA-Z0-9_']*)} Caml
  44. # Regular expression used to defines words for all internal operations.
  45. newPref v wordBreak {\w+} Caml
  46. # Prepended to 'wordBreak' when looking backwards for a word.
  47. newPref v wordBreakPreface {\W} Caml
  48. # Colorization setup
  49. newPref v commentColor red Caml
  50. newPref v directiveColor green Caml
  51. newPref v exceptionColor magenta Caml
  52. newPref v functionColor cyan Caml
  53. newPref v keywordColor blue Caml
  54. newPref v specialCharColor red Caml
  55. newPref v stringColor green Caml
  56.  
  57. set CamlCommentRegexp {\(\*(([^\*]\))|[^\*]|\r)*\*\)}
  58. set CamlPreRegexp {^\#[\t ]*[a-z]*}
  59.  
  60. # ALL THE ABOVE VARS ARE NOW GLOBAL AND MODE-VARS
  61.  
  62. #=============================================================================
  63. # Caml Menu:
  64. #
  65.  
  66. Menu -n $camlMenu -p camlMenuProc -M Caml {
  67.      "/S<U<Ocaml"
  68.      "(-"
  69.      "/C<U<OcopySelectionToCaml"
  70.      "/C<U<O<BcopyFileToCaml"
  71. }
  72.  
  73. proc camlSwitch {} {
  74.      global camlLightSig
  75.      app::launchAnyOfThese Caml camlLightSig "Please locate Caml Light:"
  76.      switchTo '$camlLightSig'
  77. }
  78.  
  79. proc camlMenuProc {menu item} {
  80.      switch $item {
  81.           caml {
  82.                 camlSwitch
  83.           }
  84.           copySelectionToCaml {
  85.                 putScrap [getSelect]
  86.                 camlSwitch
  87.           }
  88.           copyFileToCaml {
  89.                 putScrap [getText 0 [maxPos]]
  90.                 camlSwitch
  91.           }
  92.      }
  93. }
  94.  
  95. #=============================================================================
  96. # Colorize Caml comments, strings and keywords
  97. #
  98. proc colorCamlKeywords {} {
  99.     global CamlmodeVars
  100.  
  101.     set camlKeyWords        {
  102.      and as begin close do done downto else end exception for fun function if in 
  103.      let match mutable not of open or prefix rec then to try type value while 
  104.      with
  105.  }
  106.  
  107.  regModeKeywords -b {(*} {*)} -c $CamlmodeVars(commentColor) -k $CamlmodeVars(keywordColor) -s $CamlmodeVars(stringColor) Caml $camlKeyWords
  108. # regModeKeywords -a -i "#" -i "!" -i "=" -i "&" -i "." -i "+" -i "," -i "-" -i ">" -i "/" -i ":" -i ";" -i "<" -i ">" -i "@" -i "["  -i "]" -i "\{" -i "\}" -i "'" -i "|" -i "^" -I $CamlmodeVars(specialCharColor) Caml {}
  109.  unset camlKeyWords
  110. } 
  111. # call it now
  112. colorCamlKeywords; rename colorCamlKeywords ""
  113.  
  114. #=============================================================================
  115. # Colorize Caml directives
  116. #
  117. proc colorCamlDirectives {} {
  118.     global CamlmodeVars
  119.  
  120.     set camlDirectives {
  121.      cd include #open #close load compile load_object
  122.  }
  123.  regModeKeywords -a -k $CamlmodeVars(directiveColor) Caml $camlDirectives
  124.  unset camlDirectives
  125. }
  126. # call it now
  127. colorCamlDirectives; rename colorCamlDirectives ""
  128.  
  129. #=============================================================================
  130. # Colorize Caml exceptions
  131. #
  132. proc colorCamlExceptions {} {
  133.     global CamlmodeVars
  134.  
  135.     set camlExceptions    {
  136.          Bad Break Division_by_zero Empty End_of_file Exit Failure Graphic_failure 
  137.          Invalid_argument Match_failure Not_found Out_of_memory Parse_error 
  138.          Parse_failure Sys_error
  139.     }
  140.     regModeKeywords -a -k $CamlmodeVars(exceptionColor) Caml $camlExceptions
  141.     unset camlExceptions
  142. }
  143. # call it now
  144. colorCamlExceptions; rename colorCamlExceptions ""
  145.  
  146. #=============================================================================
  147. # Colorize Caml functions, types and modules
  148. #
  149. proc colorCamlFunctions {} {
  150.     global CamlmodeVars
  151.  
  152. set camlFunctions        {
  153.      abs abs_float acos add add_float add_int arg asin asr assoc assq atan atan2 
  154.      basename black blit_image blit_string blit_vect blue bool builtin 
  155.      button_down catch_break char char_for_read char_of_int chdir check_suffix 
  156.      clear clear_graph clear_parser close_graph clos_in close_out color combine 
  157.      command_line compare_strings concat concat_vect cos create_image 
  158.      create_lexer create_lexer_channel create_lexer_string create_string 
  159.      current_dir_name current_point cyan decr dirname div_float div_int do_list 
  160.      do_list_combine do_stream do_table do_vect draw_arc draw_char draw_circle 
  161.      draw_ellipse draw_image draw_string dump_image end_of_stream eq eq_Float 
  162.      eq_int eq_string event exc except exceptq exists exit exn exp failwith fhar 
  163.      file_perm filename fill_arc fill_circle fill_ellipse fill_poly fill_rect 
  164.      fill_string fill_vect find find_all flat_map float float_of_int 
  165.      float_of_string flush for_all fprint fprintf fst fstring fvect gc ge_float 
  166.      ge_int ge_string genlex get_image get_lexeme get_lexeme_char get_lexee_end 
  167.      get_lexeme_start getenv graphics green gt_float gt_int gt_string hash 
  168.      hash_param hashtbl hd image in_channel in_channel_length incr index init 
  169.      input input_binary_int input_byte input_char input_line input_value int 
  170.      int_of_char int_of_float int_of_string interactive intersect invalid_arg 
  171.      is_absolute it_list it_list2 iter key_pressed land le_float le_int 
  172.      le_string length lexbuf lexing lineto list list_it list_it2 list_length 
  173.      list_of_vect lnot log lor lshift_left lshift_right lsl lsr lt_float lt_int 
  174.      lt_string lxor magenta make_image make_lexer make_matrix make_string 
  175.      make_vect map map2 map_combine map_vect map_vect_list max mem mem_assoc 
  176.      memq merge min minus minus_float minus_int mod mouse_pos moveto mult_float 
  177.      mult_int neq_float neq_int neq_string new nth_char open_descriptor_in 
  178.      open_descriptor_out open_flag open_graph open_in open_in_bin open_in_gen 
  179.      open_out open_out_bin open_out_gen out_channel out_channel_length output 
  180.      output_binary_int output_byte output_char output_string output_value pair 
  181.      parse parsing peek plot point_color pop pos_in pos_out power pred 
  182.      prerr_char prerr_endline prerr_float prerr_int prerr_string print 
  183.      print_char print_endline print_float print_int print_newline print_string 
  184.      printexc printf push queue quit quo raise random read_float read_int 
  185.      read_key read_line really_input red ref remove rename replace_string rev 
  186.      rgb hs_end rhs_start s_irall s_irgrp s_iroth s_irusr s_isgid s_isuid 
  187.      s_iwall s_iwgrp s_iwoth s_iwusr s_ixall s_iwgrp s_ixoth s_ixusr seek_in 
  188.      seek_out set_color set_font set_line_width set_nth_char set_text_size sin 
  189.      size_x size_y snd sort sound spec split sqrt stqck status std_err std_in 
  190.      std_out stderr stdin stdout stream stream_check stream_from stream_get 
  191.      stream_next stream_of_channel stream_of_string string string_for_read 
  192.      string_length string_of_float string_of_int sub_float sub_int sub_string 
  193.      sub_vect subtract succ symbol_end symbol_start sys take tan text-size tl 
  194.      token toplevel trace transp union unit untrace vect vect_assign vect_item 
  195.      vect_length vect_of_list wait_next_event white yellow
  196.  }
  197. regModeKeywords -a -k $CamlmodeVars(functionColor) Caml $camlFunctions
  198. unset camlFunctions
  199. }
  200. # call it now
  201. colorCamlFunctions; rename colorCamlFunctions ""
  202.  
  203. #=============================================================================
  204. # Register hooks
  205. #
  206. hook::register saveHook modified "Caml"
  207.  
  208. #=============================================================================
  209. # Mark Menu:
  210. #
  211. proc Caml::MarkFile {} {
  212.   global CamlmodeVars
  213.   set pat $CamlmodeVars(funcExpr)
  214.   set end [maxPos]
  215.   set pos 0
  216.   set l {}
  217.   while {![catch {search -s -f 1 -r 1 -m 0 -i 1 $pat $pos} mtch]} {
  218.     regexp -nocase $pat [eval getText $mtch] allofit binding opttrec name
  219.     set start [lindex $mtch 0]
  220.     set end [nextLineStart $start]
  221.     set pos $end
  222.     set inds($name) [lineStart [expr $start - 1]]
  223.   }
  224.  
  225.   if {[info exists inds]} {
  226.     foreach f [lsort -ignore [array names inds]] {
  227.       set next [nextLineStart $inds($f)]
  228.       setNamedMark $f $inds($f) $next $next
  229.     }
  230.   }
  231. }